home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 03 / 1 / DISK0313.ZIP / TAXDEDCT.BAS < prev    next >
BASIC Source File  |  1984-02-25  |  9KB  |  241 lines
  1. 1000 '>>>THIS PROGRAM RECORDS INCOME TAX DEDUCTIONS
  2. 1100 '>>>HARRY G. FRIEDMAN
  3. 1200 '>>>945 Dudley Drive
  4. 1300 '>>>Shreveport, LA 71104
  5. 1400 '>>>v 1.0
  6. 1500 '
  7. 1600 '>>>Filename=TAXDEDCT.BAS
  8. 1700 '>>>DATA FILE IS RANDOM ACCESS.
  9. 1800 '>>>CODING SCHEME IS:
  10. 1900 '>>>       01/XX - Contributions
  11. 2000 '>>>       02/XX - Medical
  12. 2100 '>>>       03/XX - Interest
  13. 2200 '>>>       04/XX - Taxes
  14. 2300 '>>>THE XX PORTION OF THE CODE IS ASSIGNED TO THE PAYEE IN NUMERICAL
  15. 2400 '>>>SEQUENCE, ONE CODE NUMBER FOR EACH INDIVIDUAL PAYEE.
  16. 2500 '>>>DATES AND CODES ARE ENTERED WITHOUT "/" - AMOUNTS WITH ONLY THE
  17. 2600 '>>>DECIMAL POINT (.).
  18. 2700 '>>>MENU ITEM 6 PRINTS A LIST AND TOTAL IN DATA ENTRY FORMAT.
  19. 2800 '>>>MENU ITEM 7 PRINTS A LIST AND TOTALS SORTED BY CATAGORY AND PAYEE.
  20. 2900 '
  21. 3000 '>>>Permission is hereby granted for the unlimited use or reproduction
  22. 3100 '>>>of this program.
  23. 3200 '>>>Notification of changes or additions will be appreciated.
  24. 3300 'FILENAME=TAXDEDCT - DATA FILENAME=TAXDED.DAT
  25. 3400 KEY OFF:CLS
  26. 3500 DEFINT I
  27. 3600 OPTION BASE 1
  28. 3700 DAT=250
  29. 3800 DIM REC$(DAT)
  30. 3900 OPEN "B:TAXDED.DAT" AS #1 LEN=64
  31. 4000 FIELD #1,1 AS US$,6 AS DTE$,4 AS CDE$,45 AS PAY$,8 AS AMT$
  32. 4100 FIELD #1,64 AS RECORD$
  33. 4200 '
  34. 4300 '>>>***<<<
  35. 4400 '
  36. 4500 PRINT TAB(40) "MENU"
  37. 4600 PRINT
  38. 4700 PRINT TAB(30)1; "INITIALIZE the FILE"
  39. 4800 PRINT TAB(30)2; "CREATE or ADD a RECORD"
  40. 4900 PRINT TAB(30)3; "DISPLAY a RECORD"
  41. 5000 PRINT TAB(30)4; "EDIT a RECORD"
  42. 5100 PRINT TAB(30)5; "DELETE a RECORD"
  43. 5200 PRINT TAB(30)6; "PRINT HARDCOPY"
  44. 5300 PRINT TAB(30)7; "SORT and PRINT"
  45. 5400 PRINT TAB(30)8; "EXIT - RETURN to BASIC"
  46. 5500 PRINT:INPUT "SELECT FUNCTION ",ISELCT
  47. 5600 IF (ISELCT<1) OR (ISELCT>8) THEN PRINT "BAD SELECTION - PLEASE REENTER":        GOTO 5500
  48. 5700 ON ISELCT GOSUB 6000,7500,11000,12200,15400,17100,18900,24700
  49. 5800 GOTO 4500
  50. 5900 '
  51. 6000 '>>>INITIALIZE FILE ROUTINE<<<
  52. 6100 '
  53. 6200 INPUT "ARE YOU SURE";ANS$:IF ANS$<>"Y" THEN RETURN
  54. 6300 LSET RECORD$=CHR$(255)
  55. 6400 FOR I=1 TO 250
  56. 6500 PUT #1,I
  57. 6600 NEXT
  58. 6700 RETURN
  59. 6800 '
  60. 6900 '>>>SEQUENCE NUMBER ROUTINE<<<
  61. 7000 '
  62. 7100 INPUT "SEQUENCE NUMBER ",ISEQ
  63. 7200 IF (ISEQ<1) OR (ISEQ>250) THEN PRINT "BAD SEQUENCE NUMBER-PLEASE REENTER":      GOTO 7100 ELSE GET #1,ISEQ
  64. 7300 IF USEFLG=1 THEN 8600 ELSE RETURN
  65. 7400 '
  66. 7500 '>>>FILE ENTRY ROUTINE<<<
  67. 7600 '
  68. 7700 USEFLG=0
  69. 7800 MODE$=""
  70. 7900 INPUT "CREATE THE FILE or ADD A RECORD? - REPLY 'C' or 'A' ",MODE$
  71. 8000 PRINT
  72. 8100 IF MODE$="C" THEN ISEQ=1:GOTO 9400 ELSE MODE$="A"
  73. 8200 INPUT "Is a deleted record SEQUENCE NUMBER to be reused? - Reply Y/N ",         ANS$:PRINT
  74. 8300 IF ANS$<>"Y" THEN 8800 ELSE USEFLG=1
  75. 8400 IF ASC(US$)<>255 THEN INPUT "OVERWRITE";X$:IF X$<>"Y" THEN 4500
  76. 8500 GOTO 6900
  77. 8600 PRINT:PRINT "Inserting record at SEQUENCE NUMBER";ISEQ:PRINT
  78. 8700 GOTO 9400
  79. 8800 PRINT:PRINT "Adding record to file.":PRINT
  80. 8900 ISEQ=1
  81. 9000 FOR X=1 TO LOF(1)/128
  82. 9100 GET #1,ISEQ
  83. 9200 IF DTE$<>"ZZZZZZ" THEN ISEQ=ISEQ+1 ELSE PRINT ISEQ;"is next SEQUENCE";          " NUMBER for ADD":GOTO 9400
  84. 9300 NEXT
  85. 9400 LSET US$=CHR$(0)
  86. 9500 INPUT "DATE -   ",CALENDAR$
  87. 9600 LSET DTE$=CALENDAR$
  88. 9700 INPUT "CODE -   ",CODE$
  89. 9800 LSET CDE$=CODE$
  90. 9900 INPUT "PAYEE -  ",PAYEE$
  91. 10000 LSET PAY$=PAYEE$
  92. 10100 INPUT "AMOUNT - ",AMOUNT$
  93. 10200 RSET AMT$=AMOUNT$
  94. 10300 PUT #1,ISEQ
  95. 10400 IF USEFLG=1 THEN USEFLG=0:GOTO 4500
  96. 10500 INPUT "MORE NEW DATA";ANS$:IF ANS$="Y" THEN ISEQ=ISEQ+1:GOTO 9400 ELSE         ISEQ=ISEQ+1:LSET DTE$="ZZZZZZ"
  97. 10600 LSET CDE$=CHR$(32):LSET PAY$=CHR$(32)
  98. 10700 LSET AMT$=CHR$(32)
  99. 10800 PUT #1,ISEQ:RETURN
  100. 10900 '
  101. 11000 '>>>DISPLAY ROUTINE<<<
  102. 11100 '
  103. 11200 GOSUB 6900
  104. 11300 PRINT "SEQUENCE NUMBER ",ISEQ
  105. 11400 PRINT LEFT$(DTE$,2)+"/"+MID$(DTE$,3,2)+"/"+RIGHT$(DTE$,2)
  106. 11500 PRINT LEFT$(CDE$,2)+"/"RIGHT$(CDE$,2)
  107. 11600 PRINT PAY$
  108. 11700 PRINT AMT$
  109. 11800 INPUT "MORE RECORDS FOR DISPLAY - Y/N or E";ANS$
  110. 11900 IF (ANS$<>"Y") AND (ANS$<>"N") AND (ANS$<>"E") THEN 11800
  111. 12000 IF (ANS$="Y") THEN 11000 ELSE IF (ANS$="N") THEN RETURN ELSE PRINT:             PRINT "NEXT EDIT"
  112. 12100 '
  113. 12200 '>>>FILE EDIT ROUTINE<<<
  114. 12300 '
  115. 12400 PRINT:GOSUB 6800
  116. 12500 PRINT TAB(28)"FIELD TO CHANGE MENU"
  117. 12600 PRINT
  118. 12700 PRINT TAB(30)1;"DATE"
  119. 12800 PRINT TAB(30)2;"CODE"
  120. 12900 PRINT TAB(30)3;"PAYEE"
  121. 13000 PRINT TAB(30)4;"AMOUNT"
  122. 13100 PRINT:INPUT "WHICH FIELD TO CHANGE";FLD
  123. 13200 IF (FLD<1) OR (FLD>4) THEN PRINT "WRONG FIELD NUMBER":GOTO 13100
  124. 13300 ON FLD GOSUB 13500,13900,14300,14700
  125. 13400 GOTO 12500
  126. 13500 PRINT "CURRENT RECORD IS ";DTE$
  127. 13600 INPUT "NEW DATE          ",CALENDAR$
  128. 13700 LSET DTE$=CALENDAR$
  129. 13800 GOTO 15000
  130. 13900 PRINT "CURRENT RECORD IS ";CDE$
  131. 14000 INPUT "NEW CODE          ",CODE$
  132. 14100 LSET CDE$=CODE$
  133. 14200 GOTO 15000
  134. 14300 PRINT "CURRENT RECORD IS ";PAY$
  135. 14400 INPUT "NEW PAYEE         ",PAYEE$
  136. 14500 LSET PAY$=PAYEE$
  137. 14600 GOTO 15000
  138. 14700 PRINT "CURRENT RECORD IS ";AMT$
  139. 14800 INPUT "NEW AMOUNT       ",AMOUNT$
  140. 14900 RSET AMT$=AMOUNT$
  141. 15000 INPUT "ANY MORE CHANGES";ANS$
  142. 15100 IF ANS$="Y" THEN 13100 ELSE PUT #1,ISEQ:GOSUB 11400
  143. 15200 GOTO 4500
  144. 15300 '
  145. 15400 '>>>DELETE RECORD ROUTINE<<<
  146. 15500 '
  147. 15600 GOSUB 6900
  148. 15700 PRINT "SEQUENCE NUMBER";ISEQ
  149. 15800 PRINT LEFT$(DTE$,2)+"/"+MID$(DTE$,3,2)+"/"+RIGHT$(DTE$,2)
  150. 15900 PRINT LEFT$(CDE$,2)+"/"+RIGHT$(CDE$,2)
  151. 16000 PRINT PAY$
  152. 16100 PRINT AMT$
  153. 16200 INPUT "IS THIS THE RECORD TO DELETE";ANS$:IF ANS$<>"Y" THEN 4500
  154. 16300 LSET DTE$=CHR$(32)
  155. 16400 LSET CDE$=CHR$(32)
  156. 16500 LSET PAY$=CHR$(32)
  157. 16600 LSET AMT$=CHR$(32)
  158. 16700 PUT #1,ISEQ
  159. 16800 PRINT "THIS RECORD DELETED   ";ISEQ
  160. 16900 INPUT "ANY MORE DELETIONS";ANS$:IF ANS$="Y" THEN 15400 ELSE RETURN
  161. 17000 '
  162. 17100 '>>>HARDCOPY ROUTINE<<<
  163. 17200 '
  164. 17300 TOT=0
  165. 17400 LINCNT=0
  166. 17500 PRINT
  167. 17600 PRINT TAB(25):COLOR 1
  168. 17700 PRINT TAB(25)"PRINTING OUT DATA IN ENTRY SEQUENCE":COLOR 7:PRINT
  169. 17800 LPRINT TAB(62)"DATE   ";DATE$:LPRINT
  170. 17900 LPRINT "SEQ";TAB(8)"DATE";TAB(16)"CODE";TAB(41)"PAYEE";TAB(73)"AMOUNT"
  171. 18000 LPRINT "===";TAB(8)"====";TAB(16)"====";TAB(41)"=====";TAB(73)"======"
  172. 18100 LINCNT=LINCNT+4
  173. 18200 ISEQ=1
  174. 18300 GET #1,ISEQ
  175. 18400 LPRINT ISEQ;TAB(6)DTE$;TAB(16)CDE$;TAB(23)PAY$;TAB(71)AMT$
  176. 18500 TOT=TOT+VAL(AMT$)
  177. 18600 LINCNT=LINCNT+1:IF LINCNT=>58 THEN LPRINT CHR$(12):LINCNT=0:ELSE                GOTO 18700
  178. 18700 IF DTE$<>"ZZZZZZ" THEN ISEQ=ISEQ+1:GOTO 18300 ELSE LPRINT TAB(71)TOT:           LPRINT CHR$(12):GOTO 4500
  179. 18800 '
  180. 18900 '>>>SORT ROUTINE<<<
  181. 19000 '
  182. 19100 ISEQ=1
  183. 19200 FOR S=1 TO DAT
  184. 19300 GET #1,ISEQ
  185. 19400 REC$(S)=INPUT$(64,#1)
  186. 19500 IF ASC(US$)=0 OR ASC(US$)=32 THEN ISEQ=ISEQ+1:GOTO 19600 ELSE GOTO 19700
  187. 19600 NEXT
  188. 19700 COLOR 16,7:PRINT "SORT IN PROGRESS ";TIME$;:COLOR 7,0
  189. 19800 D=S:FLAG=0
  190. 19900 D=INT((D+1)/2)
  191. 20000 FOR Q=1 TO S-D
  192. 20100 IF MID$(REC$(Q),8,4)+MID$(REC$(Q),2,6)<=MID$(REC$(Q+D),8,4)+MID$(REC$           (Q+D),2,6) THEN 20200 ELSE SWAP REC$(Q),REC$(Q+D):FLAG=1
  193. 20200 NEXT
  194. 20300 IF FLAG=1 THEN FLAG=0:GOTO 20000
  195. 20400 IF D>1 THEN 19900
  196. 20500 PRINT:COLOR 0,7:PRINT "SORT COMPLETED   ";TIME$;:COLOR 7,0:PRINT
  197. 20600 COLOR 7,0
  198. 20700 '
  199. 20800 '>>>PRINT ROUTINE<<<
  200. 20900 '
  201. 21000 PRINT TAB(30):COLOR 1
  202. 21100 PRINT TAB(30)"PRINTING SORTED DATA":COLOR 7:PRINT
  203. 21200 LINCNT=0
  204. 21300 LPRINT TAB(20)"INCOME TAX DEDUCTIONS SORTED BY CATAGORY"
  205. 21400 LPRINT TAB(62)"DATE  ";DATE$:LPRINT
  206. 21500 LINCNT=LINCNT+2
  207. 21600 LPRINT "                       DEDUCTIONS              CODES"
  208. 21700 LPRINT "                       ==========              ====="
  209. 21800 LPRINT "                     Contributions             01/XX"
  210. 21900 LPRINT "                     Medical                   02/XX"
  211. 22000 LPRINT "                     Interest                  03/XX"
  212. 22100 LPRINT "                     Taxes                     04/XX"
  213. 22200 LPRINT "                    ================================"
  214. 22300 LPRINT TAB(3)"DATE";TAB(12)"CODE";TAB(41)"PAYEE";TAB(73)"AMOUNT"
  215. 22400 LPRINT TAB(3)"====";TAB(12)"====";TAB(41)"=====";TAB(73)"======"
  216. 22500 LINCNT=LINCNT+10
  217. 22600 SUM=0
  218. 22700 TOT=0
  219. 22800 G.TOT=0
  220. 22900 SUM$="0101"
  221. 23000 FOR S=1 TO Q
  222. 23100 IF (MID$(REC$(S),2,6)="ZZZZZZ") OR (VAL(MID$(REC$(S),57,8))=0) THEN             REC$(S)=STRING$(64,32):LPRINT REC$(S):GOTO 24200
  223. 23200 CODE$=MID$(REC$(S),8,4)
  224. 23300 IF SUM$<>CODE$ THEN LPRINT TAB(51)"TOTAL";TAB(60)USING "######,.##";TOT:        TOT=0:SUM$=CODE$:LINCNT=LINCNT+1
  225. 23400 LPRINT MID$(REC$(S),2,2)+"/"+MID$(REC$(S),4,2)+"/"+MID$(REC$(S),6,2);
  226. 23500 LPRINT TAB(12)MID$(REC$(S),8,2)+"/"+MID$(REC$(S),10,2);
  227. 23600 LPRINT TAB(20)MID$(REC$(S),12,45);
  228. 23700 LPRINT TAB(70)USING "######,.##";VAL(MID$(REC$(S),57,8))
  229. 23800 SUM=VAL(MID$(REC$(S),57,8))
  230. 23900 TOT=TOT+SUM
  231. 24000 G.TOT=G.TOT+SUM
  232. 24100 LINCNT=LINCNT+1:IF LINCNT=>58 THEN LPRINT CHR$(12):LINCNT=0 ELSE                GOTO 24200
  233. 24200 NEXT S
  234. 24300 LPRINT:LPRINT TAB(55)"GRAND TOTAL";TAB(70)USING "######,.##";G.TOT
  235. 24400 LPRINT CHR$(12)
  236. 24500 RETURN
  237. 24600 '
  238. 24700 '>>>EXIT ROUTINE<<<
  239. 24800 '
  240. 24900 CLOSE:KEY ON:CLS
  241.